home *** CD-ROM | disk | FTP | other *** search
/ Aminet 15 / Aminet 15 - Nov 1996.iso / Aminet / dev / e / ProgSuite.lha / ProgSuite / Master.e < prev    next >
Encoding:
Text File  |  1996-09-09  |  7.5 KB  |  237 lines
  1. /* Master - the ProgSuite V1.0 Master program */
  2.  
  3. MODULE 'intuition/intuition', 'intuition/screens', 'graphics/view'
  4. MODULE 'tools/ilbm', 'tools/ilbmdefs'
  5. MODULE 'amigalib/ports', 'dos/dos'
  6. MODULE 'exec/memory', 'exec/nodes', 'exec/ports'
  7.  
  8. MODULE '*Defs'
  9.  
  10. /* Screen size */
  11. CONST SIZEX = 640, SIZEY = 480, SIZEZ = 4
  12.  
  13. /* Variable to hold our own name (should be a constant...) */
  14. DEF progname: PTR TO CHAR
  15.  
  16. /* Custom screen we use for everything */
  17. DEF sptr = NIL
  18.  
  19. /* background window for the close gadget */
  20. DEF bwptr = NIL
  21.  
  22. /* offscreen bitmap, private screen and window for the initial picture */
  23. DEF bmptr = NIL, psptr:PTR TO screen, pwptr:PTR TO window
  24.  
  25. /* messageport and messages for inter-program communication */
  26. DEF masterport = NIL: PTR TO mp,
  27.     sendmsg = NIL: PTR TO portMessage, recvmsg: PTR TO portMessage
  28.  
  29. /* stuff for starting related programs */
  30. DEF homelock, homepath[100] : STRING, tmpstr[2] : STRING, command[100] : STRING
  31. DEF prognames[3] : ARRAY OF LONG, quitmsg[3] : ARRAY, auxflags[3] : ARRAY
  32.  
  33. PROC main () HANDLE
  34.  
  35.   initVariables ()
  36.   initScreen ()
  37.  
  38.   -> Show a picture to kill time during program setup
  39.   initPicture ()
  40.  
  41.   -> set up the communications port, and the final QUIT message
  42.   masterport := portCreate ('MasterPort', progname)
  43.   sendmsg := messageCreate (masterport, progname)
  44.  
  45.   -> Find the path to where we live
  46.   homelock := GetProgramDir ()
  47.   NameFromLock (homelock, homepath, 100)
  48.   SetStr (homepath, StrLen (homepath))
  49.   IF (StrCmp (RightStr (tmpstr, homepath, 1), ':') = FALSE) THEN StrAdd (homepath, '/')
  50.  
  51.   -> Start other  program(s), and wait for their WakeUp messages
  52.   IF startAuxiliaries ()
  53.  
  54.     -> Initialized; now remove startup picture
  55.     finishPicture ()
  56.  
  57.     -> Main program loop here
  58.     mainLoop ()
  59.  
  60.   ENDIF
  61.  
  62.   -> at end: send QUIT messages to the other programs
  63.   stopAuxiliaries ()
  64.  
  65.   -> finished ; normal termination
  66.   Raise (ERR_NONE)
  67. EXCEPT DO
  68.   WriteF ('\s: Exception: \d\n', progname, exception)
  69.   finishPicture ()
  70.   IF masterport THEN portRemove (masterport)
  71.   IF sendmsg THEN Dispose (sendmsg)
  72.   IF bwptr THEN CloseW (bwptr)
  73.   IF sptr THEN CloseS (sptr)
  74.   SELECT exception
  75.   CASE "WIN"
  76.     WriteF ('\s: Could not open window!\n', progname)
  77.   CASE "SCR"
  78.     WriteF ('\s: Could not open screen!\n', progname)
  79.   ENDSELECT
  80. ENDPROC
  81.  
  82. PROC initVariables ()
  83.   progname     := 'Master'
  84.   prognames[0] := 'Display' ; quitmsg[0] := QUITDISPLMSG ; auxflags[0] := FALSE
  85.   prognames[1] := 'Control' ; quitmsg[1] := QUITCONTRMSG ; auxflags[1] := FALSE
  86.   prognames[2] := 'World'   ; quitmsg[2] := QUITWORLDMSG ; auxflags[2] := FALSE
  87. ENDPROC
  88.  
  89. /* procedure to initialize the display screen */
  90.  
  91. PROC initScreen ()
  92.   sptr := OpenS (SIZEX, SIZEY, SIZEZ, V_HIRES OR V_LACE, 'ProgSuite Master',
  93.                  [SA_TYPE, PUBLICSCREEN,
  94.                   SA_PUBNAME, 'ProgSuiteScreen',
  95.                   0])
  96.   ShowTitle (sptr, FALSE)
  97.   SetColour (sptr,  0,   0,   0,   0)    -> Black (background)
  98.   SetColour (sptr,  1, 238, 204, 170)    -> Tan
  99.   SetColour (sptr,  2, 204, 102,  51)    -> Brown
  100.   SetColour (sptr,  3, 255, 102,  68)    -> Orange
  101.   SetColour (sptr,  4,   0, 102,   0)    -> DarkGreen
  102.   SetColour (sptr,  5,  51, 255,  17)    -> Green
  103.   SetColour (sptr,  6,   0,   0, 221)    -> DarkBlue
  104.   SetColour (sptr,  7,  34, 204, 221)    -> Blue
  105.   SetColour (sptr,  8, 221,   0,   0)    -> DarkRed
  106.   SetColour (sptr,  9, 255, 102,   0)    -> Red
  107.   SetColour (sptr, 10, 221, 187,   0)    -> DarkYellow
  108.   SetColour (sptr, 11, 255, 238,   0)    -> Yellow
  109.   SetColour (sptr, 12, 255, 255, 255)    -> White
  110.   SetColour (sptr, 13, 204, 204, 204)    -> Grey
  111.   SetColour (sptr, 14, 136, 136, 136)    -> DarkGrey
  112.   SetColour (sptr, 15,   0,   0,   0)    -> Black
  113.   bwptr := OpenW (0, 0, SIZEX, SIZEY, NIL, WFLG_BACKDROP OR WFLG_BORDERLESS,
  114.                   'Programs Communication Demo V0.1 (22 June 1996) Hans Jansen',
  115.                   sptr, CUSTOMSCREEN, NIL)
  116.   PubScreenStatus (sptr, 0)    -> make our screen public, for use by related programs
  117. ENDPROC
  118.  
  119. /* procedures to display/remove the initial picture */
  120.  
  121. PROC initPicture ()
  122. DEF ilbm, filename[30]:STRING, width, height, depth, bmh:PTR TO bmhd, pi:PTR TO picinfo, i, pc:PTR TO CHAR
  123.  
  124.   StrCopy (filename, 'PROGDIR:Pictures/startup.iff')
  125.   IF ilbm := ilbm_New (filename, 0)
  126.     ilbm_LoadPicture (ilbm, [ILBML_GETBITMAP, {bmptr}, 0])
  127.  
  128.     -> get a pointer to the image's picture-info.
  129.     -> extract the bitmap header, and read the picture's size.
  130.     pi := ilbm_PictureInfo (ilbm)
  131.     bmh := pi.bmhd
  132.     width := bmh.w
  133.     height := bmh.h
  134.     depth := bmh.planes
  135.  
  136.     -> If a colour-map is included in the picture, give it its own screen; 
  137.     -> otherwise open it on our main () screen
  138.     IF pi.palraw
  139.       pc := pi.palraw
  140.       psptr := OpenS (width, height, depth, V_HIRES OR V_LACE, ' Load Picture', [SA_BEHIND, TRUE, SA_LEFT, (SIZEX - width) / 2, SA_TOP, (SIZEY - height) / 2, 0])
  141.       FOR i := 0 TO pi.colours-1
  142.         SetRGB4 (psptr.viewport, i, pc[i*3]/16, pc[(i*3)+1]/16, pc[(i*3)+2]/16)
  143.       ENDFOR
  144.     ELSE
  145.       psptr := sptr
  146.     ENDIF
  147.  
  148.     -> the ilbm-handle is no longer needed, we can free it
  149.     ilbm_Dispose (ilbm)
  150.  
  151.     -> if a bitmap actually opened, open a window, and blit it in
  152.     IF bmptr
  153.       IF pwptr := OpenW (0, 0, width, height, NIL, WFLG_BORDERLESS, NIL, psptr, CUSTOMSCREEN, NIL)
  154.  
  155.         -> blit into actual dimensions the OS gave us
  156.         -> (the window might be smaller than the picture)
  157.         BltBitMapRastPort (bmptr, 0, 0, 
  158.                            pwptr.rport, 0, 0, 
  159.                            width, height, $c0);
  160.  
  161.         ilbm_FreeBitMap (bmptr)
  162.         bmptr := NIL
  163.       ENDIF
  164.     ScreenToFront (psptr)
  165.     ENDIF
  166.   ELSE
  167.     WriteF ('\s: Could not open picture file "\s"!\n', progname, filename)
  168.   ENDIF
  169.  
  170. ENDPROC
  171.  
  172. PROC finishPicture ()
  173.   IF psptr THEN ScreenToBack (psptr)
  174.   IF pwptr
  175.     CloseW (pwptr) ; pwptr := NIL
  176.   ENDIF
  177.   IF psptr
  178.     IF psptr <> sptr
  179.       CloseS (psptr) ; psptr := NIL
  180.     ENDIF
  181.   ENDIF
  182.   IF bmptr
  183.     ilbm_FreeBitMap (bmptr) ; bmptr := NIL
  184.   ENDIF
  185. ENDPROC
  186.  
  187. /* Procedures to start/stop the other programs in the package */
  188.  
  189. PROC startAuxiliaries ()
  190. DEF i
  191.   FOR i := 0 TO 2
  192.     WriteF ('\s: Starting \s...\n', progname, prognames[i])
  193.     StringF (command, 'Run \s\s\n', homepath, prognames[i])
  194.     auxflags[i] := Execute (command, 0, stdout)
  195.     IF auxflags[i]
  196.       WriteF ('\s: Waiting for \s''s WakeUp message...\n', progname, prognames[i])
  197.       WaitPort (masterport)
  198.       IF recvmsg := GetMsg (masterport) THEN messageReply (recvmsg, masterport)
  199.       messageCheckOwn (recvmsg, masterport, progname)
  200.     ENDIF
  201.   ENDFOR
  202. ENDPROC auxflags[0] AND auxflags[1] AND auxflags[2]
  203.  
  204. PROC stopAuxiliaries ()
  205. DEF i, t[14] : STRING
  206.   FOR i := 0 TO 2
  207.     IF auxflags[i]
  208.       sendmsg.msn := quitmsg[i]  -> Our Quit messages
  209.       WriteF ('\s: Sending QUIT message (\d) to \s...\n', progname, sendmsg.msn, prognames[i])
  210.       StrCopy (t, prognames[i]) ; StrAdd (t, 'Port')
  211.       IF FALSE = messageSend (sendmsg, t) THEN Raise (ERR_FINDPORT)
  212.       WriteF ('\s: Waiting for reply...\n', progname)
  213.       WaitPort (masterport)
  214.       recvmsg := GetMsg (masterport)
  215.       messageCheckOwn (recvmsg, masterport, progname)
  216.     ENDIF -> auxflags[i]
  217.   ENDFOR
  218. ENDPROC
  219.  
  220. /* The main message loop */
  221.  
  222. PROC mainLoop ()
  223.   DEF abort = FALSE
  224.  
  225.   -> mainLoop will wait forever and reply to messages, until a FINISH message arrives
  226.   REPEAT
  227.     WaitPort (masterport)
  228.     WHILE recvmsg := GetMsg (masterport)
  229.       messageCheckOwn (recvmsg, masterport, progname)
  230.       IF recvmsg.msn = FINISHMSG THEN abort := TRUE
  231.       messageReply (recvmsg, masterport)
  232.     ENDWHILE
  233.   UNTIL abort
  234.   ScreenToBack (sptr)
  235.   WriteF ('\s: Finish message received: exiting\n', progname)
  236. ENDPROC
  237.